home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / ms_dos / lib / happysrc / pcblock.c < prev    next >
Text File  |  1994-11-03  |  41KB  |  1,059 lines

  1. /*********************************************************************
  2.  *
  3.  *       *** HAPPy Pascal Compiler ***
  4.  *             program,block コンパイル処理
  5.  *
  6.  *                void programme(void)
  7.  *                void block(Set fsys,enum symbol fsy,ctp *fprocp)
  8.  *
  9.  *       Copyright (c) H.Asano 1992,1994.
  10.  *
  11.  *********************************************************************/
  12.  
  13. #define  EXTERN extern
  14. #include <stdlib.h>
  15. #include <string.h>
  16. #include "pascomp.h"
  17. #include "pcpcd.h"
  18.  
  19. void block(Set,enum symbol,ctp*) ;
  20. static void body(Set,ctp*)  ;
  21. static void paramcopy(ctp*) ;
  22. static void statement(Set)  ;
  23. static void compoundstatement(Set)    ;
  24. static void ifstatement(Set)     ;
  25. static void whilestatement(Set)  ;
  26. static void repeatstatement(Set) ;
  27. static void forstatement(Set)    ;
  28. static void forident(attr*)      ;
  29. static void forexpres1(Set,attr);
  30. static void forexpres2(Set,attr,enum symbol,int*,int*) ;
  31. static void fordostatement(Set,attr,enum symbol,int) ;
  32. static void assignment(Set,ctp*) ;
  33. static void casestatement(Set) ;
  34. static void withstatement(Set) ;
  35. static void gotostatement(Set) ;
  36. extern void call(Set,ctp*) ;
  37. extern void expression(Set) ;
  38. extern void selector(Set,ctp*) ;
  39. extern ctp  *mkctp(char*,enum idclass,stp*,ctp*) ;
  40. extern void enterid(ctp*) ;
  41. extern ctp  *searchid(Set);
  42. extern ctp  *searchsection(ctp*) ;
  43. extern void insymbol(void);
  44. extern void skip(Set) ;
  45. extern void updatelc(int)    ;
  46. extern void pcerr(int,char*) ;
  47. extern char *inttoch(long)   ;
  48. extern char *inttoch(long)   ;
  49. extern char *inttoch(long) ;
  50. extern Set  *mkset(Set*,int,...) ;
  51. extern Set  *orset(Set*,Set*)    ;
  52. extern Set  *dfset(Set*,Set*) ;
  53. extern int  crelabel(void) ;
  54. extern void labeldecl(Set);
  55. extern void constdecl(Set);
  56. extern void typedecl(Set);
  57. extern void vardecl(Set,ctp*);
  58. extern void procfuncdecl(Set,enum symbol,ctp**);
  59. extern void gencupejp(enum pcdmnc, int, int) ;
  60. extern void genjump(enum pcdmnc,int) ;
  61. extern void putlabel(int) ;
  62. extern void genent(void) ;
  63. extern void genret(stp*) ;
  64. extern void putprogname(char*);
  65. extern void putentv(int,int) ;
  66. extern void putq(void) ;
  67. extern void gen0(enum pcdmnc) ;
  68. extern void genp(enum pcdmnc, int) ;
  69. extern void gen0t(enum pcdmnc,stp*) ;
  70. extern void gen1t(enum pcdmnc,stp*,int) ;
  71. extern void gen2t(enum pcdmnc,stp*,int,int) ;
  72. extern void genlda(int,int) ;
  73. extern void genldc(char,long) ;
  74. extern void genchk(stp*,int,long,long) ;
  75. extern void convertint(stp*) ;
  76. extern void load(void) ;
  77. extern void loadaddress(void) ;
  78. extern void store(attr) ;
  79. extern void gencompare(enum pcdmnc,char,int) ;
  80. extern void getbounds(stp*,long*,long*) ;
  81. extern void checkbounds(stp*,int) ;
  82. extern boolean compatible(stp*,stp*) ;
  83. extern boolean assigncompati(stp*,stp*) ;
  84. extern int  align(stp*,int) ;
  85. extern void constant(Set,stp**,union valu*) ;
  86. extern void *Malloc(int)  ;
  87.  
  88. static int lcmax     ;
  89. static int mainlabel ;                  /* メインブロックのラベル値   */
  90.  
  91. /*******************************************************
  92.  *   programme() : program の 処理
  93.  *     形式は、次の2通り
  94.  *        program ident( filename,filename,・・・ ) ;
  95.  *        program ident;
  96.  *******************************************************/
  97. void programme(void)
  98. {
  99.   extfilep  *extfp ;                    /* ファイル名格納エリアのポインタ   */
  100.   Set       fsys   ;                    /* block で 最初に現れるsymbolの集合*/
  101.   Set       casesys;                    /* casesyだけの集合 (ワーク)        */
  102.   ctp       *cp    ;                    /* input,output名前登録用           */
  103.   int       i      ;
  104.   int       adr    ;
  105.   boolean   err196 ;
  106.  
  107.      fextfilep = nil ;
  108.  
  109.      insymbol() ;                       /* 最初のsymbolを読む         */
  110.  
  111.      if(sy == progsy) {
  112.       insymbol();
  113.       if(sy != ident) pcerr(2,"");      /* 名前がない                 */
  114.       putprogname(id) ;                 /* プログラム名の出力         */
  115.       insymbol();
  116.       if((sy != lparent) && (sy != semicolon))
  117.        pcerr(14,"");                    /* ; がない                   */
  118.  
  119.       if(sy == lparent) {               /* プログラム引数の処理       */
  120.        do {
  121.         insymbol();
  122.         if(sy == ident) {
  123.           err196 = false    ;
  124.           extfp = fextfilep ;
  125.           while(extfp) {                /* 重複指定チェック           */
  126.            if(!strcmp(extfp->filename,id)) {
  127.             pcerr(196,id) ;             /* プログラム引数に同じ名前   */
  128.             err196 = true ;
  129.            }
  130.            extfp = extfp->nextfile ;
  131.           }
  132.           if(!err196) {
  133.            if(!(i=strcmp(id,"input")) || !(strcmp(id,"output"))) {
  134.             if(i!=0) {                  /* outputの時                 */
  135.              adr = outputadr ;
  136.              defineoutput = true ;      /* outputファイル定義済       */
  137.             }
  138.             else {                      /* inputの時                  */
  139.              adr = inputadr ;
  140.              defineinput = true ;       /* inputファイル定義済        */
  141.             }
  142.             cp = mkctp(id,vars,textptr,nil) ;
  143.             cp->n.v.vkind = actual ;
  144.             cp->n.v.vlev  = level  ;
  145.             cp->n.v.vaddr = adr    ;
  146.             enterid(cp);
  147.            }
  148.  
  149.            extfp = (extfilep*)Malloc(sizeof(extfilep)) ;
  150.            strcpy(extfp->filename,id);
  151.        extfp->nextfile = fextfilep ;
  152.            fextfilep = extfp ;
  153.           }
  154.  
  155.           insymbol() ;
  156.           if((sy != comma) && (sy != rparent))
  157.            pcerr(20,"") ;               /* , がない                   */
  158.         }
  159.     else pcerr(2,"") ;              /* 名前がない                 */
  160.        } while(sy == comma);
  161.        if(sy != rparent) pcerr(14,"");  /* ; がない                   */
  162.        insymbol();
  163.       }
  164.       if(sy!=semicolon) pcerr(14,"");   /* ; がない                   */
  165.       else insymbol();
  166.      }
  167.      else pcerr(3,"") ;                 /* program がない             */
  168.  
  169.      fsys = blockbegsys        ;        /* fsys =  blockbegsys        */
  170.      orset(&fsys,&statbegsys)  ;        /*       + statbegsys         */
  171.      mkset(&casesys,casesy,-1) ;
  172.      dfset(&fsys,&casesys)     ;        /*       - casesy             */
  173.  
  174.      do {                               /* 誤り回復のためrepeat       */
  175.       block(fsys,period,nil) ;          /* block の コンパイル        */
  176.       if(sy != period) pcerr(21,"") ;   /*  *がない                   */
  177.      } while(sy != period)   ;
  178.  
  179. }
  180.  
  181. /**************************************/
  182. /* block() : block の 翻訳            */
  183. /**************************************/
  184. void block(Set fsys,         /* blockに最初に現れるsymbolの集合    */
  185.            enum symbol fsy,  /* blockの終わりのsymbol              */
  186.            ctp *fprocp)      /* proc/funcの名前ポインタ(mainはnil) */
  187.  
  188. {
  189.   enum symbol lsy ;
  190.   Set bodyfsys    ;
  191.   ctp *pffwdptr = nil  ;                /* 手続き・関数の前方宣言リスト*/
  192.   ctp *lcp        ;
  193.   extfilep *extp  ;                     /* プログラム引数リスト       */
  194.  
  195.      do {                               /* declare partの処理         */
  196.       if(sy == labelsy) {
  197.        insymbol() ;
  198.        labeldecl(fsys) ;                /* label節の処理              */
  199.       }
  200.       if(sy == constsy) {
  201.        insymbol() ;
  202.        constdecl(fsys) ;                /* const節の処理              */
  203.       }
  204.       if(sy == typesy)  {
  205.        insymbol() ;
  206.        typedecl(fsys)  ;                /* type節の処理               */
  207.       }
  208.       if(sy == varsy)   {
  209.        insymbol() ;
  210.        vardecl(fsys,fprocp)   ;         /* var節の処理                */
  211.       } ;
  212.  
  213.       if(fprocp == nil) {               /* メインブロックの時         */
  214.        extp = fextfilep ;
  215.        while(extp) {                    /* プログラム引数の宣言チェック*/
  216.         strcpy(id,extp->filename) ;
  217.         lcp = searchsection(display[level].fname) ;
  218.         if(!lcp) pcerr(197,id) ;        /* プログラム引数が未宣言      */
  219.         extp = extp->nextfile  ;
  220.        }
  221.  
  222.        genp(iMST,0) ;                   /*  mst命令の生成             */
  223.        mainlabel = crelabel()       ;   /*  メインブロックのラベル名  */
  224.        gencupejp(iCUP,0,mainlabel ) ;   /*  cup命令の生成             */
  225.        gen0(iSTP)   ;                   /*  stp命令の生成             */
  226.  
  227.       }
  228.  
  229.       while((sy == procsy) || (sy == funcsy)) {
  230.        lsy = sy   ;
  231.        insymbol() ;
  232.        procfuncdecl(fsys,lsy,&pffwdptr) ;/* 手続き・関数の宣言処理     */
  233.       } ;
  234.  
  235.       while(pffwdptr) {                 /* 手続き・関数の前方宣言チェック*/
  236.        pcerr(118,pffwdptr->name) ;      /*  前方宣言の実体がない      */
  237.        pffwdptr = pffwdptr->n.pf.sd.d.af.a.fwdptr ;
  238.       }
  239.  
  240.       if(sy != beginsy) {
  241.        pcerr(18,"") ;                   /* 宣言部に誤りがある         */
  242.        skip(fsys) ;
  243.       } ;
  244.  
  245.      } while(! inset(statbegsys,sy)) ;  /* 誤り回復のため繰り返し     */
  246.  
  247.      if(sy == beginsy) insymbol()   ;
  248.      else              pcerr(17,"") ;   /* begin がない               */
  249.  
  250.      bodyfsys = fsys ;
  251.      addset(bodyfsys,casesy) ;
  252.      do {
  253.       body(bodyfsys,fprocp)     ;       /* begin ~ end の処理        */
  254.       if(sy != fsy) {
  255.        pcerr(6,"") ;                    /* 不当な記号が現れた         */
  256.        skip(fsys)  ;
  257.       }
  258.      } while((sy != fsy) && (! inset(blockbegsys,sy))) ;
  259. }
  260.  
  261. /**************************************/
  262. /* body() : body部 の 翻訳            */
  263. /**************************************/
  264. static void body(Set fsys,ctp *fprocp)
  265. {
  266.   lbp *llp     ;
  267.   int entname  ;
  268.   Set statementfsys ;
  269.   boolean test ;
  270.  
  271.      topnew  = topmax = lcaftermarkstack ;
  272.      entname = (!fprocp) ? mainlabel               /* mainのbodyの時       */
  273.                  : fprocp->n.pf.sd.d.af.a.pfname ; /* 手続き・関数のラベル値*/
  274.  
  275.      putlabel(entname)    ;             /* ラベルの出力               */
  276.      genent()             ;
  277.  
  278.      if(fprocp) paramcopy(fprocp) ;     /* 手続き・関数の時 仮引数を
  279.                                                スタックにコピーする   */
  280.      lcmax = lc ;
  281.  
  282.     /**** statement の 処理 ****/
  283.  
  284.      statementfsys = fsys ;             /* statementfsys =            */
  285.      addset(statementfsys,semicolon);   /*  fsys + semicolon          */
  286.      addset(statementfsys,endsy)    ;   /*       + endsy              */
  287.      do {
  288.       do {
  289.        statement(statementfsys);
  290.       } while(inset(statbegsys,sy)) ;
  291.       if(test=(sy == semicolon)) insymbol() ;  /* ; ならば次のsymbolを読む */
  292.      } while(test) ;                           /* ; ならば繰り返す    */
  293.      if(sy == endsy) insymbol() ;
  294.      else pcerr(13,"") ;                /* end がない                 */
  295.  
  296.    /**** ラベルの定義チェック ****/
  297.  
  298.      llp = display[top].flabel;
  299.      while(llp) {                       /* 宣言られたラベルについて   */
  300.       if(!llp->defined)                 /*   未定義                   */
  301.        pcerr(168,inttoch((long)llp->labval)); /* ラベル未出現         */
  302.       llp = llp->nextlab ;
  303.      }
  304.  
  305.      if(fprocp) {                       /* 手続き・関数内のブロックの時*/
  306.       genret(fprocp->idtype) ;          /* 型に応じたret命令生成      */
  307.       if(fprocp->klass == func)         /* 関数の時                   */
  308.        if(!display[top].funcassign)     /*   関数名への代入がない時   */
  309.         pcerr(176,fprocp->name) ;       /*     関数名への代入がない   */
  310.      }
  311.      else genret(nil)        ;          /* mainブロックの時はretp命令 */
  312.  
  313.      putentv(topmax,lcmax)   ;
  314.      if(!fprocp) putq()      ;          /* mainブロックの時 q指令を出力*/
  315.  
  316. }
  317.  
  318. /**************************************/
  319. /* paramcopy() : 値引数のコピー処理   */
  320. /**************************************/
  321. static void paramcopy(ctp *fprocp)
  322. {
  323.   ctp *lcp ;
  324.   int llc ;
  325.  
  326.      llc = lcaftermarkstack ;
  327.      lcp = fprocp->next     ;           /* 引数の先頭                 */
  328.  
  329.      while(lcp) {
  330.       llc = align(parmptr,llc) ;        /* 境界調整                   */
  331.       if(lcp->klass == vars)            /* 変数の時                   */
  332.        if(lcp->idtype)
  333.         if(lcp->idtype->form > power) { /* 配列・レコード型            */
  334.          if(lcp->n.v.vkind == actual) { /* 値引数                     */
  335.           genlda(0,lcp->n.v.vaddr) ;    /* lda命令                    */
  336.           gen2t(iLOD,nilptr,0,llc) ;    /* lod命令                    */
  337.           gen2t(iMOV,nil,1,lcp->idtype->size); /* mov命令             */
  338.          }
  339.          llc += ptrsize ;
  340.         }
  341.         else llc += lcp->idtype->size ; /* スカラ、範囲、集合、ポインタ  */
  342.       lcp = lcp->next ;
  343.      }
  344. }
  345.  
  346. /**************************************/
  347. /* statement() : 文 の コンパイル     */
  348. /**************************************/
  349. static void statement(Set fsys)
  350. {
  351.   Set ws ;
  352.   Set statfolsys ;                      /* 文の後に続くsymbolの集合   */
  353.   Set identsys   ;                      /* 名前の集合                 */
  354.   ctp *lcp ;
  355.   lbp *llp ;
  356.  
  357.      mkset(&statfolsys, semicolon,endsy,elsesy,untilsy,-1);
  358.      mkset(&identsys,   vars,field,func,proc,-1) ;
  359.  
  360.   /**** label の 処理 ****/
  361.      if(sy == intconst) {
  362.       llp = display[level].flabel ;
  363.       while(llp) {
  364.        if(llp->labval == (int)val.ival) {  /* 宣言されたラベルの時    */
  365.         if(llp->defined)
  366.          pcerr(165,inttoch(val.ival));/* ラベルが再度宣言された       */
  367.         putlabel(llp->labname)     ;  /* ラベル値の出力               */
  368.         llp->defined = true        ;  /* 定義済                       */
  369.         break ;
  370.        }
  371.        else llp = llp->nextlab     ;    /* ラベル名が違う時           */
  372.       }
  373.       if(!llp)
  374.        pcerr(167,inttoch(val.ival));    /* ラベルが未宣言             */
  375.       insymbol() ;
  376.       if(sy == colon) insymbol()   ;
  377.       else pcerr(5,"")             ;    /* : がない                  */
  378.      }
  379.  
  380.   /***********************/
  381.  
  382.      if((! inset(fsys,sy)) && (sy != ident)) {    /* 許されないsymbolの時 */
  383.       pcerr(6,"") ;                               /* 不当なsymbolが現れた */
  384.       skip(fsys)  ;
  385.      }
  386.      if((inset(fsys,sy)) || (sy == ident)) {      /* 文の最初としてOKの時 */
  387.       switch(sy) {
  388.        case ident :    lcp=searchid(identsys) ;
  389.                        insymbol() ;
  390.                        if(lcp->klass != proc)
  391.                         assignment(fsys,lcp) ;      /* 代入文の処理   */
  392.                        else if((lcp->klass == proc) &&
  393.                                (inset(statfolsys,sy) || (sy == lparent)))
  394.                         call(fsys,lcp) ;            /* 手続きのみ呼出 */
  395.                        else {
  396.                         pcerr(6,"") ;   /* 不当な記号が現れた         */
  397.                         ws = fsys ;
  398.                         orset(&ws,&statfolsys) ;
  399.                         skip(ws)  ;     /* 読み飛ばし                 */
  400.                        }
  401.                        break ;
  402.        case beginsy  : insymbol() ;
  403.                        compoundstatement(fsys) ;
  404.                        break ;
  405.        case gotosy   : insymbol() ;
  406.                        gotostatement(fsys) ;
  407.                        break ;
  408.        case ifsy     : insymbol() ;
  409.                        ifstatement(fsys) ;
  410.                        break ;
  411.        case casesy   : insymbol() ;
  412.                        casestatement(fsys) ;
  413.                        break ;
  414.        case whilesy  : insymbol() ;
  415.                        whilestatement(fsys) ;
  416.                        break ;
  417.        case repeatsy : insymbol() ;
  418.                        repeatstatement(fsys) ;
  419.                        break ;
  420.        case forsy    : insymbol() ;
  421.                        forstatement(fsys) ;
  422.                        break ;
  423.        case withsy   : insymbol() ;
  424.                        withstatement(fsys) ;
  425.       }
  426.  
  427.       if(! inset(statfolsys,sy)) {
  428.        pcerr(6,"") ;                    /* 不当な記号が現れた         */
  429.        skip(fsys) ;
  430.       }
  431.      }
  432. }
  433.  
  434. /***************************************/
  435. /* compoundstatement() : begin文の処理 */
  436. /***************************************/
  437. static void compoundstatement(Set fsys)
  438. {
  439.   Set ws;
  440.   boolean test;
  441.  
  442.      do {
  443.       do {
  444.        mkset(&ws,semicolon,endsy,-1);
  445.        orset(&ws,&fsys) ;
  446.        statement(ws) ;
  447.       } while(inset(statbegsys,sy)) ; /* statement以外がでてきた時終わり*/
  448.       if(test = (sy == semicolon)) insymbol() ; /* ; ならば次のsymbol */
  449.      } while(test) ;                    /* ; ならば繰り返す           */
  450.  
  451.      if(sy == endsy) insymbol() ;       /* end ならば次のsymbol       */
  452.      else pcerr(13,"") ;                /*  end がない                */
  453. }
  454.  
  455. /***************************************/
  456. /*   gotostatement() : goto文の処理    */
  457. /***************************************/
  458. static void gotostatement(Set fsys)
  459. {
  460.   lbp *llp ;
  461.   int ttop,ttop1 ;
  462.   boolean found ;
  463.  
  464.      if(sy == intconst) {               /* ラベルは整数               */
  465.       found = false ;
  466.       ttop  = top   ;
  467.       while(display[ttop].occur != blck)
  468.         ttop-- ;                        /* block水準を探す            */
  469.       ttop1 = ttop ;
  470.       do {
  471.        llp = display[ttop].flabel ;
  472.        while(llp) {
  473.         if(llp->labval == (int)val.ival) { /* ラベル値が同じ          */
  474.          found = true ;
  475.          if(ttop == ttop1)              /* ラベルの定義水準と同じ     */
  476.           genjump(iUJP,llp->labname) ;  /* ujp命令                    */
  477.          else
  478.           gencupejp(iEJP,level-ttop,llp->labname); /* ejp命令         */
  479.          break ;                        /* whileループを抜ける        */
  480.         }
  481.         else llp = llp->nextlab ;
  482.        }
  483.        ttop-- ;
  484.       } while((! found) && (ttop != 0)) ;
  485.       if(! found)
  486.        pcerr(167,inttoch(val.ival));    /* ラベルが未宣言             */
  487.       insymbol() ;
  488.      }
  489.      else pcerr(164,"") ;               /* ラベルが整数でない         */
  490. }
  491.  
  492. /***************************************/
  493. /*    ifstatement() : if文の処理       */
  494. /***************************************/
  495. static void ifstatement(Set fsys)
  496. {
  497.   int lcix1,lcix2 ;
  498.   Set ws ;
  499.  
  500.      ws = fsys ;
  501.      addset(ws,thensy) ;
  502.      expression(ws) ;                   /* ifの次の式を評価           */
  503.      load()               ;             /* 式の値をloadする           */
  504.      if(gattr.typtr)
  505.       if(gattr.typtr != boolptr)        /* 式の値がbooleanでない時    */
  506.        pcerr(146,"if文")  ;             /*  演算対象は論理型でないと駄目*/
  507.      lcix1 = crelabel()   ;
  508.      genjump(iFJP,lcix1)  ;             /* 偽ならelseまたはifの終わりに飛ぶ*/
  509.  
  510.      if(sy == thensy) insymbol() ;
  511.      else pcerr(52,"")    ;             /* then がない                */
  512.  
  513.      ws = fsys ;
  514.      addset(ws,elsesy)    ;
  515.      statement(ws)        ;             /* thenの次の文を処理         */
  516.  
  517.      if(sy == elsesy) {
  518.       lcix2 = crelabel()  ;
  519.       genjump(iUJP,lcix2) ;             /* elseの終わりまで飛ぶ       */
  520.       putlabel(lcix1)     ;             /* elseのラベル出力           */
  521.       insymbol()          ;
  522.       statement(fsys)     ;             /* elseの次の文を処理         */
  523.       putlabel(lcix2)     ;             /* elseの終わりのラベル出力   */
  524.      }
  525.      else putlabel(lcix1) ;             /* elseがない時 if文の終わりのラベル*/
  526. }
  527.  
  528. /***************************************/
  529. /*  whilestatement() : while文の処理   */
  530. /***************************************/
  531. static void whilestatement(Set fsys)
  532. {
  533.   int laddr ;                           /* 戻りラベル値               */
  534.   int lcix  ;                           /* 飛び越しラベル値           */
  535.   Set ws    ;
  536.  
  537.      laddr = crelabel() ;               /* ラベル値を得る             */
  538.      putlabel(laddr)    ;               /* ラベル値の出力             */
  539.  
  540.      ws = fsys ;
  541.      addset(ws,dosy)    ;
  542.      expression(ws)     ;               /* whileの次の式の評価        */
  543.      load()             ;               /* 式の値をloadする           */
  544.      if(gattr.typtr)
  545.       if(gattr.typtr != boolptr)        /* 式の値がbooleanでない時    */
  546.        pcerr(146,"while文")  ;          /*  演算対象は論理型でないと駄目*/
  547.      lcix = crelabel()  ;               /* 飛び越しラベル値を得る     */
  548.      genjump(iFJP,lcix) ;               /* fjp命令の生成              */
  549.      if(sy == dosy) insymbol() ;
  550.      else pcerr(54,"")  ;               /* do がない                  */
  551.  
  552.      statement(fsys)    ;               /* 文の処理                   */
  553.  
  554.      genjump(iUJP,laddr);               /* ujp命令でwhile文の先頭に戻る*/
  555.  
  556.      putlabel(lcix)     ;               /* 飛び先ラベルの出力         */
  557. }
  558.  
  559. /*****************************************/
  560. /*  repeatstatement() : repeat文の処理   */
  561. /*****************************************/
  562. static void repeatstatement(Set fsys)
  563. {
  564.   int laddr ;                           /* 戻りラベル値               */
  565.   Set ws    ;
  566.   boolean test ;
  567.  
  568.      laddr = crelabel() ;               /* ラベル値を得る             */
  569.      putlabel(laddr)    ;               /* ラベル値の出力             */
  570.  
  571.      mkset(&ws,semicolon,untilsy,-1);
  572.      orset(&ws, &fsys) ;
  573.      do {
  574.       do {
  575.        statement(ws)   ;                 /* 文の処理                   */
  576.        if(inset(statbegsys,sy))
  577.         pcerr(14,"") ;                   /*  ; がない                  */
  578.       } while(inset(statbegsys,sy)); /*  文として正しいsymbolならリピート */
  579.       if(test = (sy==semicolon)) insymbol() ; /* ; ならば次のsymbol    */
  580.      } while(test) ;                     /*      ; ならば繰り返す      */
  581.  
  582.      if(sy == untilsy) {
  583.       insymbol() ;
  584.       expression(fsys) ;                /* untilに続く式の評価        */
  585.       load()             ;              /* 式の値をloadする           */
  586.       if(gattr.typtr)
  587.        if(gattr.typtr != boolptr)       /* 式の値がbooleanでない時    */
  588.         pcerr(146,"repeat文") ;         /*  式は論理式でない          */
  589.       genjump(iFJP,laddr) ;             /* fjp命令の生成              */
  590.      }
  591.      else pcerr(53,"") ;                /* until がない               */
  592. }
  593.  
  594. /***************************************/
  595. /* forstatement() : for文のコンパイル  */
  596. /***************************************/
  597. static void forstatement(Set fsys)
  598. {
  599.   attr lattr ;
  600.   int  llc   ;
  601.   enum symbol lsy ;
  602.   int  looplabel  ;                     /* for文のループ用ラベル値    */
  603.   int  forendlabel;                     /* for文終了の飛び先ラベル値  */
  604.   Set  ws    ;
  605.  
  606.      llc = lc ;                         /* 変数割りつけ状況を退避     */
  607.      lattr.typtr  = nil   ;             /* 制御変数の属性初期設定     */
  608.      lattr.kind   = varbl ;
  609.      lattr.access = drct  ;
  610.      lattr.vlevel = level ;
  611.      lattr.dplmt  = 0     ;
  612.  
  613.      if(sy == ident) forident(&lattr) ;
  614.      else {
  615.       pcerr(2,"") ;                     /* 名前がない                 */
  616.       mkset(&ws,becomes,tosy,downtosy,dosy,-1) ;
  617.       orset(&ws,&fsys) ;
  618.       skip(ws)    ;                     /*     読み飛ばし             */
  619.      }
  620.  
  621.      if(sy == becomes) forexpres1(fsys,lattr) ;  /* 式1の処理         */
  622.      else {
  623.       pcerr(51,"") ;                    /* := がない                  */
  624.       mkset(&ws,tosy,downtosy,dosy,-1) ;
  625.       orset(&ws,&fsys) ;
  626.       skip(ws)     ;                    /*     読み飛ばし             */
  627.      }
  628.  
  629.      if((sy == tosy) || (sy == downtosy)) {
  630.       lsy = sy     ;                    /* to か downsyを後で判断するため退避*/
  631.       forexpres2(fsys,lattr,lsy,&looplabel,&forendlabel) ; /* 式2の処理      */
  632.      }
  633.      else {
  634.       pcerr(55,"") ;                    /* to / downto がない         */
  635.       mkset(&ws,dosy,-1) ;
  636.       orset(&ws,&fsys)   ;
  637.       skip(ws)           ;              /*     読み飛ばし             */
  638.      }
  639.  
  640.      if(sy == dosy) insymbol() ;
  641.      else pcerr(54,"")   ;              /* do がない                  */
  642.  
  643.      fordostatement(fsys,lattr,lsy,looplabel) ;    /* doに続く文の処理*/
  644.  
  645.      putlabel(forendlabel) ;            /* for文の終わりラベル出力    */
  646.  
  647.      lc = llc              ;            /* 一時変数を開放             */
  648. }
  649.  
  650. /***************************************/
  651. /* forident() : for文の制御変数処理    */
  652. /***************************************/
  653. static void forident(attr *fattr)
  654. {
  655.   ctp *lcp ;
  656.   Set ws   ;
  657.   int ltop ;
  658.  
  659.      mkset(&ws,vars,-1) ;
  660.      lcp = searchid(ws) ;               /* 変数の中から名前を探す     */
  661.  
  662.      (*fattr).typtr = lcp->idtype ;     /*   変数の型                 */
  663.      (*fattr).kind  = varbl       ;
  664.      if(lcp->n.v.vkind == actual) {     /* 実変数ならばOK             */
  665.       (*fattr).access = drct ;
  666.       (*fattr).vlevel = lcp->n.v.vlev ; /*    変数の宣言レベル        */
  667.       (*fattr).dplmt  = lcp->n.v.vaddr; /*    変数の割りつけアドレス  */
  668.       ltop = top ;
  669.       while(display[ltop].occur != blck) /* block水準を探す           */
  670.        ltop-- ;
  671.       if(lcp->n.v.vlev != ltop)         /* 制御変数の定義水準が       */
  672.        pcerr(186,id) ;                  /*  for文と同一ぶろっくでない */
  673.      }
  674.      else {
  675.       pcerr(187,id) ;                   /* 変数引数を制御変数に使えない */
  676.       (*fattr).typtr = nil ;
  677.      }
  678.  
  679.      if((*fattr).typtr)
  680.       if(((*fattr).typtr->form > subrange) ||     /* ポインタ型、集合型、   */
  681.                                                   /* レコード型、ファイル型*/
  682.          (realptr == (*fattr).typtr)) {           /* またはreal型         */
  683.        pcerr(188,id) ;                            /* 制御変数の型が不当   */
  684.        (*fattr).typtr = nil ;
  685.       }
  686.  
  687.      insymbol() ;
  688. }
  689.  
  690. /***************************************/
  691. /* forexpres1() : for文の式1処理       */
  692. /*      for 制御変数:=式1 ・・・・         */
  693. /***************************************/
  694. static void forexpres1(Set fsys,attr fattr)
  695. {
  696.   Set ws ;
  697.  
  698.      insymbol() ;
  699.  
  700.      mkset(&ws,tosy,downtosy,dosy,-1) ;
  701.      orset(&ws,&fsys) ;
  702.      expression(ws)   ;                 /* 式1を評価                  */
  703.  
  704.      if(gattr.typtr)
  705.       if((gattr.typtr->form != scalar) || (gattr.typtr == realptr))
  706.        pcerr(144,"for文の初期値")  ;/* 式が順序式でない               */
  707.       else if(compatible(fattr.typtr,gattr.typtr)) {   /* 制御変数と型が同じ*/
  708.        load() ;                         /* 式の値をload               */
  709.        store(fattr) ;                   /* 制御変数域にstore          */
  710.       }
  711.       else pcerr(145,"初期値") ;        /* 制御変数と初期値の型が不適合*/
  712. }
  713.  
  714. /****************************************/
  715. /* forexpres2() : for文の式2処理        */
  716. /*   for ・・・ to/downto 式2 do ・・・       */
  717. /****************************************/
  718. static void forexpres2(Set fsys,attr fattr,
  719.                        enum symbol fsy,int *flooplabel,int *forendlabel)
  720. {
  721.   stp  *lspfin ;
  722.   char typind  ;                        /* gencompareに引き渡す型文字 */
  723.   int  tempadr ;                        /* 一時変数域のアドレス       */
  724.   Set ws ;
  725.  
  726.      insymbol() ;
  727.  
  728.      ws = fsys ;
  729.      addset(ws,dosy) ;
  730.      expression(ws) ;                   /* 式2を評価                  */
  731.  
  732.      lspfin = gattr.typtr ;             /* 終値の属性を退避           */
  733.      if(lspfin == boolptr)      typind = 'b' ;    /* boolean          */
  734.      else if(lspfin == charptr) typind = 'c' ;    /* char             */
  735.      else                       typind = 'i' ;    /* integer/列挙型   */
  736.  
  737.      if(lspfin)
  738.       if((lspfin->form != scalar) || (lspfin == realptr))
  739.        pcerr(144,"for文の終値")  ;          /* 順序式でない           */
  740.       else if(compatible(fattr.typtr,lspfin)) {  /* 制御変数と型が同じ*/
  741.        load() ;                             /* 式の値をload           */
  742.        updatelc(align(lspfin,lc) - lc) ;    /* 境界合わせ             */
  743.        tempadr = lc ;
  744.        gen2t(iSTR,lspfin,0,tempadr) ;       /* 一時変数域に式の値をstr*/
  745.        *flooplabel = crelabel() ;
  746.        if(!debug)                           /* debugでないならば      */
  747.         putlabel(*flooplabel) ;             /* ループラベル出力       */
  748.        gattr = fattr  ;
  749.        load()          ;                    /* 制御変数をload         */
  750.        gen2t(iLOD,lspfin,0,tempadr) ;       /* 一時変数(式2)をload    */
  751.        updatelc(lspfin->size)       ;
  752.        if(lc > lcmax) lcmax =lc ;           /* 最大変数域サイズの更新 */
  753.        (fsy == tosy) ? gencompare(iLEQ,typind,0) /* to ならeq命令生成 */
  754.                      : gencompare(iGEQ,typind,0);/* downtoならgeq命令生成 */
  755.       }
  756.       else pcerr(145,"終値") ;          /* 制御変数と終値の型が不適合  */
  757.  
  758.      *forendlabel = crelabel() ;        /* for文終了後の飛び先ラベル生成*/
  759.      genjump(iFJP,*forendlabel);        /* fjp命令生成                */
  760.  
  761.      if(debug) {                        /* debugの時                  */
  762.       gattr = fattr   ;
  763.       load()          ;                 /* 制御変数をload             */
  764.       checkbounds(fattr.typtr,52);      /* 範囲チェック               */
  765.       store(fattr) ;
  766.       gen2t(iLOD,lspfin,0,tempadr)  ;   /* 一時変数(式2)をload        */
  767.       checkbounds(fattr.typtr,53)   ;   /* 範囲チェック               */
  768.       gen2t(iSTR,lspfin,0,tempadr) ;    /* 一時変数域に式の値をstr    */
  769.  
  770.       putlabel(*flooplabel) ;           /* ループラベル出力           */
  771.       gattr = fattr   ;
  772.       load()          ;                 /* 制御変数をload             */
  773.       gen2t(iLOD,lspfin,0,tempadr)  ;   /* 一時変数(式2)をload        */
  774.       (fsy == tosy) ? gencompare(iLEQ,typind,0) /* to ならleq命令生成 */
  775.                     : gencompare(iGEQ,typind,0);/* downtoならgeq命令生成 */
  776.       genjump(iFJP,*forendlabel);       /* fjp命令生成                */
  777.      }
  778. }
  779.  
  780. /**********************************************/
  781. /* fordostatement() : for文のdoに続く文の処理 */
  782. /*                     for ・・・  do 文         */
  783. /**********************************************/
  784. static void fordostatement(Set fsys,attr fattr,
  785.                            enum symbol fsy,int looplabel)
  786. {
  787.      statement(fsys) ;                  /* 文の処理                   */
  788.      (fsy == tosy) ? gen1t(iNXT,fattr.typtr,fattr.dplmt)   /* nxt命令 */
  789.                    : gen1t(iNXD,fattr.typtr,fattr.dplmt) ; /* nxd命令 */
  790.      genjump(iUJP,looplabel) ;          /* ujp命令で戻る              */
  791. }
  792.  
  793. /*****************************************/
  794. /* withstatement() : with文のコンパイル  */
  795. /*****************************************/
  796. static void withstatement(Set fsys)
  797. {
  798.   ctp *lcp     ;
  799.   int oldlc    ;                         /* lcの退避域                */
  800.   int oldtop   ;                         /* display top の退避域      */
  801.   boolean test ;
  802.   Set ws       ;
  803.  
  804.      oldtop = top ;                     /* 今のdisplayのtopを退避     */
  805.      oldlc  = lc  ;                     /* 今のlcを退避               */
  806.  
  807.      do {
  808.       if(sy == ident) {
  809.        mkset(&ws,vars,field,-1) ;
  810.        lcp = searchid(ws) ;             /* 名前を変数、フィールド名より探す*/
  811.        insymbol() ;
  812.       }
  813.       else {
  814.        pcerr(2,"") ;                    /* 名前がない                 */
  815.        lcp = uvarptr ;                  /* 未定義用の変数ポインタ     */
  816.       }
  817.       mkset(&ws,comma,dosy,-1) ;
  818.       orset(&ws,&fsys) ;
  819.       selector(ws,lcp) ;                /* 変数の処理                 */
  820.       if(gattr.typtr)
  821.        if(gattr.typtr->form == records)
  822.         if(top < Displimit) {           /* displayがまだある時        */
  823.          top++ ;
  824.          display[top].fname  = gattr.typtr->sf.re.fstfld ; /* 最初の欄*/
  825.          display[top].flabel = nil ;    /* ラベル欄の初期設定         */
  826.          if(gattr.access == drct) {     /* 直接参照の時               */
  827.           display[top].occur = crec ;   /* 固定部のレコード欄         */
  828.           display[top].clev  = gattr.vlevel ; /* 定義水準             */
  829.           display[top].cdspl = gattr.dplmt  ; /* 相対アドレス         */
  830.          }
  831.          else {                         /* 間接参照の時               */
  832.           loadaddress() ;               /* loadaddress命令            */
  833.           updatelc(align(nilptr,lc)-lc);/* lcの境界調整               */
  834.           gen2t(iSTR,nilptr,0,lc) ;     /* str命令                    */
  835.           display[top].occur = vrec ;   /* 可変レコード欄             */
  836.           display[top].vdspl = lc   ;   /* loadaddress 格納場所       */
  837.           updatelc(ptrsize)         ;   /* lcを1アドレス分進める      */
  838.           if(lc > lcmax) lcmax = lc ;
  839.          }
  840.         }
  841.         else
  842.          pcerr(603,inttoch((long)Displimit));/* 名前の入れ子が深すぎる */
  843.        else pcerr(140,"")  ;            /* 変数の型がレコードでない   */
  844.       if(test = (sy == comma)) insymbol() ; /* , なら次の変数を読む   */
  845.      } while(test) ;                    /* , なら次の変数の処理へ    */
  846.  
  847.      if(sy == dosy) insymbol() ;
  848.      else pcerr(54,"") ;                /* do がない                  */
  849.  
  850.      statement(fsys)   ;                /* with文配下の文の処理       */
  851.  
  852.      top = oldtop ;                     /* 水準を元に戻す             */
  853.      lc  = oldlc  ;                     /* lcを元に戻す               */
  854. }
  855.  
  856. /**************************************/
  857. /* assignment() : 代入文のコンパイル  */
  858. /**************************************/
  859. static void assignment(Set fsys,ctp *fcp)
  860. {
  861.   attr lattr ;                          /* 1つ前の属性                */
  862.   long lmin,lmax ;
  863.   boolean cstflag ;
  864.   Set ws ;
  865.  
  866.      ws = fsys ;
  867.      addset(ws,becomes)    ;
  868.      addset(ws,relop  )    ;            /* := を = と間違えやすいので
  869.                                            この場合だけ別エラーにする */
  870.      selector(ws, fcp)     ;            /* 左辺の処理                 */
  871.  
  872.      if(fcp->klass == func)             /* 左辺が関数の時             */
  873.       if(fcp->n.pf.pfdeckind == standard) {
  874.        pcerr(150,fcp->name) ;           /* 標準関数への代入は駄目     */
  875.        gattr.typtr = nil ;
  876.       }
  877.       else if(fcp->n.pf.sd.d.pfkind == formal)
  878.         pcerr(151,"") ;                 /* 関数引数への代入は駄目     */
  879.       else if(display[fcp->n.pf.sd.d.pflev+1].funcname != fcp)
  880.        pcerr(177,fcp->name) ;           /* ここでは代入できない       */
  881.       else display[fcp->n.pf.sd.d.pflev+1].funcassign = true ;
  882.                                         /* 関数名への代入あり         */
  883.  
  884.      if(sy==relop && op==eqop) {
  885.            pcerr(49,"") ;               /*  = でなく := を使え        */
  886.            sy = becomes ;               /* := に 置き換える           */
  887.      }
  888.      if(sy == becomes) {
  889.       if(gattr.typtr)
  890.        if(gattr.typtr->form == subrange)    /* 範囲型の時は 範囲値を */
  891.         getbounds(gattr.typtr,&lmin,&lmax) ;/*   求めておく           */
  892.        if((gattr.access != drct) ||     /* 直接参照でないか           */
  893.           (gattr.typtr->form > power))  /* 配列型、レコード型、ファイル型*/
  894.         loadaddress() ;                 /* の時は、アドレスをのせる   */
  895.       lattr = gattr   ;                 /* 左辺を退避                 */
  896.       insymbol() ;
  897.       expression(fsys) ;                /* 右辺の処理                 */
  898.       if(gattr.typtr)
  899.        cstflag = gattr.kind == cst ;    /* 右辺が定数の時 真          */
  900.        if(gattr.typtr->form <= power)   /* スカラー、範囲、ポインタ、集合*/
  901.         load() ;
  902.        else loadaddress() ;
  903.  
  904.       if((lattr.typtr) && (gattr.typtr)) {
  905.        if((lattr.typtr == realptr) &&          /* 左辺が実数型で      */
  906.           (compatible(gattr.typtr,intptr))) {  /* 右辺が整数型の時    */
  907.         gen0(iFLT) ;                           /* 実数に変換 flt命令  */
  908.         gattr.typtr = realptr ;
  909.        }
  910.  
  911.        if(assigncompati(lattr.typtr,gattr.typtr)) /* 代入可能な時     */
  912.         switch(lattr.typtr->form) {           /* 型によって振り分ける */
  913.          case subrange :
  914.            if(cstflag) {
  915.             if((lmin > gattr.cval.ival) || /*   コンパイル時に        */
  916.                (lmax < gattr.cval.ival))   /*   範囲内チェックを行    */
  917.              pcerr(129,"") ;               /* 代入可能でない          */
  918.            }
  919.            else checkbounds(lattr.typtr,49) ;/* 実行時にチェック      */
  920.            store(lattr) ;
  921.            break ;
  922.          case scalar   :
  923.            checkbounds(lattr.typtr,49) ;       /* 上限・下限のチェック */
  924.          case pointer  :
  925.            store(lattr) ;
  926.            break ;
  927.          case power :
  928.            checkbounds(lattr.typtr,50) ;       /* 上限・下限のチェック */
  929.            store(lattr) ;
  930.            break ;
  931.          case arrays  :
  932.          case records :
  933.            gen2t(iMOV,nil,1,lattr.typtr->size) ;
  934.         }
  935.        else pcerr(129,"") ;             /* 代入可能でない            */
  936.       }
  937.      }
  938.      else  pcerr(51,"") ;               /*  := がない                 */
  939. }
  940.  
  941. /*****************************************/
  942. /* casestatement() : case文のコンパイル  */
  943. /*****************************************/
  944. typedef struct caseinfo cip ;
  945. struct caseinfo {
  946.    cip  *next   ;
  947.    int  csstart ;                       /* P-codeラベル値             */
  948.    long cslab   ;                       /* 定数値                     */
  949. } ;
  950.  
  951. static void casestatement(Set fsys)
  952. {
  953.   stp *lsp,*lsp1 ;
  954.   cip *lpt,*lpt1,*lpt2,*lpt3,*fstptr;
  955.   int laddr ;
  956.   int lcix,lcix1;
  957.   long lmin,lmax;
  958.   union valu lval ;
  959.   boolean test ;
  960.   Set ws ;
  961.  
  962.      mkset(&ws,ofsy,comma,colon,-1) ;
  963.      expression(ws) ;                   /* caseに続く式の処理         */
  964.      load() ;                           /* 式の値をload               */
  965.      lsp = gattr.typtr ;
  966.      if(lsp)
  967.       if((lsp->form != scalar) || (lsp == realptr)) {
  968.        pcerr(144,"case文の選択式") ;    /* 順序式でない               */
  969.        lsp = nil     ;
  970.       }
  971.       else convertint(gattr.typtr) ;    /* 必要ならord命令生成        */
  972.  
  973.      lcix = crelabel()  ;
  974.      genjump(iUJP,lcix) ;               /* 式の値チェックへ飛ぶ       */
  975.  
  976.      if(sy == ofsy) insymbol() ;
  977.      else pcerr(8,"")          ;        /* of がない                  */
  978.  
  979.      fstptr = nil ;
  980.      laddr = crelabel() ;
  981.      do {
  982.       lpt = nil ;
  983.       lcix1 = crelabel() ;
  984.       do {
  985.        mkset(&ws,comma,colon,-1);
  986.        orset(&ws,&fsys) ;
  987.        constant(ws,&lsp1,&lval) ;       /* 定数の処理                 */
  988.        if(lsp1)
  989.         if(lsp == lsp1) {               /* 式の型と定数の型を比較     */
  990.         /*** 新しい定数を昇順となるようlpt1 と lpt2 の間に挿入する ****/
  991.          lpt1 = fstptr ;
  992.          lpt2 = nil    ;
  993.          while(lpt1 != nil) {
  994.           if(lpt1->cslab >= lval.ival) {
  995.            if(lpt1->cslab == lval.ival)/* 前の定数と同じ値の時        */
  996.             pcerr(156,"") ;            /* case文の名札が再度定義された*/
  997.            break ;
  998.           }
  999.           lpt2 = lpt1;
  1000.           lpt1 = lpt1->next ;
  1001.          }
  1002.          lpt = (cip*)Malloc(sizeof(cip)) ;
  1003.          lpt->next            = lpt1      ;
  1004.          lpt->cslab           = lval.ival ;
  1005.          lpt->csstart         = lcix1     ;
  1006.          if(lpt2==nil) fstptr = lpt       ; /* 一度もwhileループを回ってない*/
  1007.          else lpt2->next      = lpt       ;
  1008.          if(lpt1==nil) lmax   = lval.ival ; /* 定数の最大値           */
  1009.         }
  1010.         else pcerr(147,"") ;            /* case文の名札の型がおかしい */
  1011.        if(test=(sy==comma)) insymbol() ;/*   , ならば次の定数を読む   */
  1012.       } while(test) ;                   /*   , ならば次の定数の処理   */
  1013.       if(sy == colon) insymbol() ;
  1014.       else pcerr(5,"") ;                /* : がない                   */
  1015.       putlabel(lcix1) ;
  1016.       ws = fsys;
  1017.       addset(ws,semicolon) ;
  1018.       lpt3 = lpt;                       /* QuickCのバグのため(lpt破壊)*/
  1019.       do {                              /* 誤り回復のため繰り返し     */
  1020.        statement(ws)       ;            /* 定数に対する文の処理       */
  1021.       } while(inset(statbegsys,sy));
  1022.       if(lpt3) genjump(iUJP,laddr);
  1023.       if(test=(sy==semicolon)) insymbol() ;/* ; ならば次の定数を読む  */
  1024.       if(sy==endsy) break ;             /*   endなら処理終わり        */
  1025.      } while(test) ;                    /*    ; ならば次の定数の処理  */
  1026.  
  1027.      putlabel(lcix) ;
  1028.  
  1029.      if(fstptr) {
  1030.       lmin = fstptr->cslab;
  1031.       if(lmax - lmin < Cixmax) {
  1032.        genchk(intptr,51,lmin,lmax);
  1033.        if(lmin!=0)                      /* 最小値が0の時はそのまま    */
  1034.         if(labs(lmin) <=32767)          /* qオペランドで表現できる値  */
  1035.          gen1t(iDEC,intptr,(int)lmin) ; /* deci  最小値               */
  1036.         else {                          /* 大きな値                   */
  1037.          genldc('i',lmin);              /* ldci lmin                  */
  1038.          gen0(iSBI) ;                   /* sbi                        */
  1039.         }
  1040.        gen0(iXJP) ;
  1041.        do {
  1042.         while(fstptr->cslab > lmin) {
  1043.          gen0(iUJC) ;
  1044.          lmin++ ;
  1045.         }
  1046.         genjump(iUJP,fstptr->csstart);
  1047.         fstptr = fstptr->next ;
  1048.         lmin++ ;
  1049.        } while(fstptr) ;
  1050.        putlabel(laddr) ;
  1051.       }
  1052.       else
  1053.        pcerr(601,inttoch((long)Cixmax)) ; /* case文の選択の範囲が大きすぎる*/
  1054.      }
  1055.  
  1056.      if(sy == endsy) insymbol() ;
  1057.      else pcerr(13,"") ;                /* end がない                 */
  1058. }
  1059.